home *** CD-ROM | disk | FTP | other *** search
/ Programmer Power Tools / Programmer Power Tools.iso / clipper / nannws33.arc / DB_DEMO.PRG < prev    next >
Text File  |  1988-11-01  |  13KB  |  632 lines
  1. * Program: Db_demo.prg
  2. * Author:  Don L. Powells
  3. * Version: Summer '87
  4. * Note(s): Routine to demonstrate DBEDIT()
  5. *          with a user-defined function.
  6. *
  7. *          Database Files:
  8. *            Customer.dbf   Serialno.dbf
  9. *          Index Files:
  10. *            Cust_no.NTX    State.ntx
  11. *            Company.NTX    Zip.NTX
  12. *            Last.ntx
  13. *
  14. * Copyright (c) 1988 Nantucket Corp.
  15.  
  16. * Save original DOS screen to restore
  17. * upon exit.
  18. SAVE SCREEN TO dosscrn
  19. CLEAR SCREEN
  20. SET WRAP ON
  21. beep_on = .T.   && Turn on Beep function.
  22.  
  23. * Open the database and associated indexes.
  24. USE Customer
  25. SET INDEX TO Company,Cust_no,Last,Zip,State
  26.  
  27. * Declare and initialize arrays and memory
  28. * variable parameters.
  29. t = 6
  30. l = 1
  31. b = 20
  32. r = 78
  33.  
  34. DECLARE fields[FCOUNT()-1],pics[FCOUNT()-1],;
  35.    heads[FCOUNT()-1],foots[FCOUNT()-1]
  36.  
  37. * Fill fields array with field names.
  38. AFIELDS(fields)
  39.  
  40. udf = "Db_func"
  41.  
  42. AFILL(pics,"")
  43. pics[3] = "@R 999-999-9999"
  44. pics[9] = "99999-9999"
  45. pics[11] = "@!"
  46.  
  47. heads[1] = "Customer No."
  48. heads[2] = "Company Name"
  49. heads[3] = "Phone No."
  50. heads[4] = "Extension"
  51. heads[5] = "Address"
  52. heads[6] = "Address"
  53. heads[7] = "City"
  54. heads[8] = "State"
  55. heads[9] = "Zip code"
  56. heads[10] = "First Name"
  57. heads[11] = "MI"
  58. heads[12] = "Last Name"
  59.  
  60. headsep = CHR(205)   && CHR(205) = '═'
  61. colsep = CHR(179)    && CHR(179) = '│'
  62. footsep = CHR(196)   && CHR(196) = '─'
  63.  
  64. foots[1] = "NO EDIT Allowed"
  65. foots[5] = "Line one"
  66. foots[6] = "Line two"
  67.  
  68. * Incremental seek string for speed scroll.
  69. mstring = ""
  70.  
  71. * Draw screen constants.
  72. Saycenter(1,"Clipper Summer 87")
  73. Saycenter(2,"DBEDIT() Demo")
  74. @ 3,0 SAY REPLICATE(CHR(196),80)
  75. * Draw box to surround table.
  76. @ 5,0 TO 21,79
  77.  
  78. * Draw Browse menu.
  79. Saycenter(22,"<ESC>:Exit <Return>:Edit "+;
  80.    "<F3>:Order <Del>:Del/Recall <F4>:Pack")
  81.  
  82. * If Empty file force EOF() bang and user
  83. * function call.
  84. IF RECCOUNT() = 0
  85.    KEYBOARD CHR(24)
  86. ENDIF
  87.  
  88. * Call DBEDIT() and start browsing.
  89. DBEDIT(t,l,b,r,fields,udf,pics,heads,headsep,;
  90.    colsep,footsep,foots)
  91. CLOSE DATABASES
  92. RESTORE SCREEN FROM dosscrn
  93. RETURN
  94.  
  95.  
  96. * Db_func() - User-defined function
  97. * for DBEDIT().
  98. *
  99. FUNCTION Db_func
  100. PARAMETERS mstatus,fld_ptr
  101. PRIVATE request
  102.  
  103. * Assume normal return.
  104. request = 1
  105.  
  106. * Save last keystroke.
  107. keystroke = LASTKEY()
  108.  
  109. * Assign current field name to mem variable.
  110. curfield = fields[fld_ptr]
  111.  
  112. * Save current cursor position.
  113. mrow = ROW()
  114. mcol = COL()
  115.  
  116. IF mstatus = 0
  117.    * Idle.
  118.    request = Idlestat()
  119.       
  120. ELSEIF mstatus = 1
  121.    * Beginning-of-file.
  122.    request = Pasttop()
  123.  
  124. ELSEIF mstatus = 2
  125.    * End-of-file.
  126.    request = Pastbott(curfield)
  127.  
  128. ELSEIF mstatus = 3
  129.    * Empty database file.
  130.    request = Emptydbf(curfield,fld_ptr)
  131.  
  132. ELSEIF mstatus = 4
  133.    * Keystroke exception.
  134.    request = Keyexcep(keystroke,curfield,fld_ptr,mrow,mcol)
  135.  
  136. ELSE
  137.    request = Idlestat()
  138.  
  139. ENDIF
  140. RETURN(request)
  141.  
  142. * Idlestat()
  143. * Process idle status (0) of DBEDIT().
  144. * Updates record number and deleted status.
  145. *
  146. FUNCTION Idlestat
  147. mrecno = RECNO()
  148. @ 1,60 SAY "Record " +;
  149.    ALLTRIM(TRANSFORM(mrecno,"@Z"))
  150. IF DELETED()
  151.    @ 2,60 SAY "** DELETED **"
  152. ELSE
  153.    @ 2,60 SAY "             "
  154. ENDIF
  155.  
  156. morder = INDEXORD()
  157. @ 2,5 SAY "Order: "+ UPPER(INDEXKEY(morder))+;
  158.    SPACE(5)
  159.  
  160. * Draw Incremental Seek Prompt.
  161. @ 23,0 SAY "Enter " + TRIM(INDEXKEY(0))+":   "
  162.  
  163. @ 4,0
  164. Saycenter(4,"BROWSE MODE")
  165. RETURN(1)
  166.  
  167.  
  168. * Pasttop()
  169. * Process status (1) of DBEDIT().
  170. *
  171. FUNCTION Pasttop
  172. Beep("NORM")
  173. @ 0,0
  174. @ 0,0 SAY "** Beginning of File **"
  175. INKEY(.5)
  176. @ 0,0
  177. RETURN(1)
  178.  
  179.  
  180. * Pastbott()
  181. * Process status (2) of DBEDIT().
  182. *
  183. FUNCTION Pastbott
  184. PRIVATE curfield,retval
  185. PARAMETERS curfield
  186. @ 0,0
  187. @ 0,0 SAY "** End of File **"
  188. Beep("NORM")
  189. retval = Apendrec(curfield)
  190. @ 0,0
  191. RETURN(retval)
  192.  
  193.  
  194. * Apendrec()
  195. * Append a blank record to the file.
  196. *
  197. FUNCTION Apendrec
  198. PRIVATE curfield,fld_ptr,retval
  199. PARAMETERS curfield, fld_ptr
  200. retval = 1
  201. @ 4,0
  202. Saycenter(4,"BROWSE MODE")
  203. resp = "N"
  204. @ 24,0
  205. @ 24,0 SAY "Do you want to add a new " + ;
  206.    "record (Y/N)? " GET resp PICTURE "@!"
  207. READ
  208. @ 24,0
  209. IF resp = "Y"
  210.    APPEND BLANK
  211.    * Get the next unique serial number from
  212.    * the serial number file.
  213.    currarea = SELECT()
  214.    SELECT 0
  215.    USE Serialno
  216.    mCust_no = Ser_num + 1
  217.    REPLACE Ser_num WITH mCust_no
  218.    USE
  219.    SELECT (currarea)
  220.    REPLACE Cust_no WITH mCust_no
  221.    IF curfield != "CUST_NO"
  222.       Fld_edit(curfield,fld_ptr)
  223.    ENDIF
  224.    retval = 2
  225.    Idlestat()
  226. ENDIF
  227. RETURN(retval)
  228.  
  229.  
  230. * Emptydbf()
  231. * Process status (3) of DBEDIT().
  232. *
  233. FUNCTION Emptydbf
  234. PRIVATE curfield,fld_ptr,retval
  235. PARAMETERS curfield, fld_ptr
  236. * Enter append mode.
  237. request = Apendrec(curfield,fld_ptr)
  238. * Display status.
  239. Idlestat()
  240. RETURN(retval)
  241.  
  242.  
  243. * Keyexcep()
  244. * Process keystroke exceptions.
  245. *
  246. FUNCTION Keyexcep
  247. PRIVATE request,keystroke,curfield,;
  248.    fld_ptr,mrow,mcol
  249. PARAMETERS keystroke,curfield,fld_ptr,;
  250.    mrow,mcol
  251. IF keystroke = 27       && <ESC>.
  252.    * Exit.
  253.    request = 0
  254.  
  255. ELSEIF keystroke = 13
  256.    * Edit current cell.
  257.    request = Fld_edit(curfield,fld_ptr)
  258.  
  259. ELSEIF keystroke = 7    && <Del>.
  260.    * Delete/Recall current record.
  261.    request = Delrecall()
  262.  
  263. ELSEIF keystroke = -2   && <F3>.
  264.    * Select index order.
  265.    request = Pickordr()
  266.       
  267. ELSEIF keystroke = -3   && <F4>.
  268.    * Pack the file.
  269.    request = Fil_pack()
  270.  
  271. ELSEIF ASC(CHR(keystroke)) >= 32 .AND.;
  272.    ASC(CHR(keystroke)) <= 126  && Alphanumeric
  273.    * Speed Scroll/Incremental Seek.
  274.    request = Incseek(curfield,keystroke)
  275.  
  276. ELSEIF keystroke = 8    && <Backspace>.
  277.    * Decremental Seek.
  278.    request = Decseek()
  279.  
  280. ELSE
  281.    Not_yet()
  282.    request = 1
  283. ENDIF
  284.  
  285. RETURN(request)
  286.  
  287.  
  288. * Delrecall()
  289. * Delete/Recall records toggle.
  290. *
  291. FUNCTION Delrecall
  292. IF DELETED()
  293.    RECALL
  294. ELSE
  295.    DELETE
  296. ENDIF
  297. * Update Deleted status.
  298. Idlestat()
  299. RETURN(1)
  300.  
  301.  
  302. * Pickordr()
  303. * Select the index order for file.
  304. *
  305. FUNCTION Pickordr
  306. PRIVATE retval,ntxcnt,ntxkey,maxntx,subscrpt,;
  307.    tr,lc,br,rc,ordscrn
  308. retval = 1
  309. * Count the number of indexes.
  310. ntxcnt = 0
  311. ntxkey = INDEXKEY(ntxcnt)
  312. IF "" != ntxkey
  313.    DO WHILE "" != ntxkey
  314.       ntxcnt = ntxcnt + 1
  315.       ntxkey = INDEXKEY(ntxcnt)
  316.    ENDDO
  317.    * Display menu of keys.
  318.    DECLARE ntxarray[ntxcnt]
  319.    maxntx = 0
  320.    FOR i = 1 TO ntxcnt
  321.       ntxarray[i] = INDEXKEY(i)
  322.       maxntx = MAX(LEN(ntxarray[i]),maxntx)
  323.    NEXT
  324.    tr = 8
  325.    lc = (80 - maxntx)/2
  326.    br = 15
  327.    rc = lc + maxntx
  328.    ordscrn = SAVESCREEN((tr - 2),(lc - 1),;
  329.       (br + 1), (rc + 1))
  330.    @ 4,0
  331.    Saycenter(4,"Select Order")
  332.    @ (tr - 1),(lc - 1) TO (br + 1), (rc + 1)
  333.    SCROLL(tr,lc,br,rc,0)
  334.    subscrpt = ACHOICE(tr,lc,br,rc,ntxarray)
  335.    IF subscrpt != 0
  336.       SET ORDER TO subscrpt
  337.       @ 23,0
  338.       mstring = ""
  339.    ENDIF
  340.    RESTSCREEN((tr - 2),(lc - 1),(br + 1),;
  341.       (rc + 1),ordscrn)
  342.    retval = 2
  343. ELSE
  344.    Beep("BOZO")
  345.    Err_msg("No index files are available.")
  346. ENDIF
  347. Idlestat()
  348. RETURN(retval)
  349.  
  350.  
  351. * Fil_pack()
  352. * Remove deleted records from the file.
  353. *
  354. FUNCTION Fil_pack
  355. Beep("NORM")
  356. retval = 1
  357. resp = "N"
  358. @ 0,0
  359. @ 0,0 SAY "Record removal is permanent. " + ;
  360.    "Continue?(Y/N) ";
  361.     GET resp PICTURE "@!" VALID(resp $ "Y/N")
  362. READ
  363. @ 0,0
  364. IF resp = "Y"
  365.    @ 24,0
  366.    @ 24,0 SAY "Removing deleted records..."
  367.    PACK
  368.    retval =2
  369.    @ 24,0
  370.    Idlestat()
  371. ENDIF
  372. RETURN(retval)
  373.  
  374.  
  375. * Fld_edit()
  376. * Edit cell contents in table using
  377. * memory variable.
  378. *
  379. FUNCTION Fld_edit
  380. PRIVATE curfield,fld_ptr
  381. PARAMETERS curfield,fld_ptr
  382. @ 4,0
  383. Saycenter(4,"EDIT MODE")
  384. * Assume no screen refresh.
  385. retval = 1
  386.  
  387. * Get controlling index key.
  388. ntx_expr = INDEXKEY(0)
  389. * Expand for comparison after edit to determine
  390. * whether screen refresh is needed.
  391. ntx_eval = &ntx_expr
  392. SET CURSOR ON       && DBEDIT() turns
  393.                     ** cursor off by default.
  394.  
  395. * Store field contents to memory variable.
  396. get_data = &curfield.
  397.  
  398. * Allow up and down arrows to exit READ.
  399. READEXIT(.T.)
  400.  
  401. * Prevent edits on Customer number field.
  402. IF curfield != "CUST_NO"
  403.    @ mrow,mcol GET get_data;
  404.       PICTURE get_pic(curfield,fld_ptr)
  405.    READ
  406.  
  407.    * Turn off up, down arrow key exiting.
  408.    READEXIT(.F.)
  409.    keystroke = LASTKEY()     && Save exit key.
  410.  
  411.    IF keystroke != 27 .AND. UPDATED()
  412.       * Store changes to database.
  413.       REPLACE &curfield. WITH get_data
  414.  
  415.       IF !EMPTY(ntx_expr)
  416.          * File indexed..check for altered
  417.          * key field.
  418.  
  419.          IF ntx_eval != (&ntx_expr)
  420.             * key field altered..re-draw screen.
  421.             retval = 2
  422.  
  423.           ENDIF
  424.       ENDIF
  425.  
  426.       IF retval <> 2
  427.          * Certain keys move cursor after
  428.          * edit if no refresh.
  429.  
  430.          IF keystroke = 5
  431.             * Up arrow.
  432.             KEYBOARD CHR(5)
  433.  
  434.          ELSEIF keystroke = 18
  435.             * PgUp.
  436.             KEYBOARD CHR(5)
  437.  
  438.          ELSEIF keystroke = 24
  439.             * Down arrow.
  440.             KEYBOARD CHR(24)
  441.  
  442.          ELSEIF keystroke = 3
  443.             * PgDn.
  444.             KEYBOARD CHR(24)
  445.  
  446.          ELSEIF keystroke = 13;
  447.             .OR. keystroke > 32
  448.             * Return or Typed past end.
  449.             * Move right.
  450.             KEYBOARD CHR(4)
  451.  
  452.          ENDIF
  453.       ENDIF
  454.    ENDIF
  455. ELSE
  456.    @ 0,0
  457.    Beep("BOZO")
  458.    @ 0,0 SAY "No Edits allowed on this field!"
  459.    INKEY(1)
  460.    @ 0,0
  461. ENDIF
  462. SET CURSOR OFF
  463. RETURN(retval)
  464.  
  465.  
  466. * Get_pic()
  467. * Return matching picture string for
  468. * specified field.
  469. *
  470. FUNCTION Get_pic
  471.  
  472. PRIVATE pstring, s,field,fld_ptr
  473. PARAMETERS field,fld_ptr
  474.  
  475. DO CASE
  476. CASE !EMPTY(pics[fld_ptr])
  477.    * Check picture array for a picture string.
  478.    pstring = pics[fld_ptr]
  479.  
  480. CASE TYPE(field) = "C"
  481.    * Character field is bounded by window
  482.    * width.
  483.    pstring = "@KS" + ;
  484.       LTRIM(STR(MIN(LEN(&field), 78)))
  485.  
  486. CASE TYPE(field) = "N"
  487.    * Convert to character to
  488.    * help format picture string.
  489.    s = STR(&field.)
  490.  
  491.    IF "." $ s
  492.       * Decimals in numeric.  Use the
  493.       * form "9999.99".
  494.       pstring = REPLICATE("9",;
  495.          AT(".", s) - 1) + "."
  496.       pstring = pstring + REPLICATE("9", LEN(s) - LEN(pstring))
  497.  
  498.    ELSE
  499.       * No decimals.  Only need the
  500.       * correct length.
  501.       pstring = REPLICATE("9", LEN(s))
  502.  
  503.    ENDIF
  504.  
  505. OTHERWISE
  506.    * No picture.
  507.    pstring = ""
  508.  
  509. ENDCASE
  510.  
  511. RETURN(pstring)
  512.  
  513.  
  514. * Incseek()
  515. * Incremental seek of records.
  516. *
  517. FUNCTION Incseek
  518. PRIVATE curfield,retval,keystroke
  519. PARAMETERS curfield,keystroke
  520. old_recnum = recno()
  521. mstring = mstring + CHR(keystroke)
  522. @ 23,16
  523. @ 23,16 SAY mstring
  524. IF UPPER(INDEXKEY(0)) != "CUST_NO"
  525.    SEEK TRIM(mstring)
  526. ELSE
  527.    SEEK VAL(TRIM(mstring))
  528. ENDIF
  529.  
  530. IF !FOUND()
  531.    Beep("BOZO")
  532.    Err_msg("Entry does not exist.")
  533.    GO old_recnum
  534. ENDIF
  535. RETURN(2)
  536.  
  537.  
  538. * Decseek()
  539. * Decremental seek when <Backspace>
  540. * is pressed.
  541. *
  542. FUNCTION Decseek
  543. mstring = SUBSTR(mstring,1,(LEN(mstring)-1))
  544. IF UPPER(INDEXKEY(0)) != "CUST_NO"
  545.    SEEK TRIM(mstring)
  546. ELSE
  547.    SEEK VAL(TRIM(mstring))
  548. ENDIF
  549. @ 23,16   
  550. @ 23,16 SAY mstring   
  551. RETURN(2)
  552.  
  553.  
  554. * Saycenter()
  555. * Function to center a string on a given row.
  556. * Usage: Saycenter(row#,expC)
  557. *
  558. FUNCTION Saycenter
  559. PARAMETERS trow,in_string
  560. IF LEN(in_string)>=80
  561.    @ trow,0 SAY in_string
  562. ELSE
  563.    @ trow,(80 - LEN(in_string))/2 SAY in_string
  564. ENDIF
  565.  
  566. RETURN (.T.)
  567.  
  568.  
  569. * Not_yet()
  570. * Prints option not available message.
  571. *
  572. FUNCTION Not_yet
  573. @ 0,0
  574. Beep("NORM")
  575. @ 0,0 SAY "Option is not available yet." +;
  576.           " Press any key to continue."
  577. INKEY(0)
  578. @ 0,0
  579. RETURN(.T.)
  580.  
  581.  
  582. * Beep()
  583. * Sounds a tone to get user's attention.
  584. * Usage: Beep("NORM") && Info or warning.
  585. *        Beep("BOZO") && Error beep.
  586. *
  587. FUNCTION Beep
  588. PARAMETER beeptype
  589. IF beep_on
  590.    IF UPPER(beeptype) = "BOZO"
  591.       TONE(87.3,1)
  592.       TONE(40,3.5)
  593.    ELSE
  594.       TONE(261.7,1)
  595.       TONE(392,3.5)
  596.    ENDIF
  597. ENDIF
  598. RETURN(.T.)
  599.  
  600.  
  601. * Err_msg()
  602. * Prints an error message or warning on row 0.
  603. * Usage: Err_msg("Error or warning message")
  604. *
  605. FUNCTION Err_msg
  606. PARAMETER e_msg
  607. @ 0,0
  608. err_scrn = SAVESCREEN(0,0,1,79)
  609. @ 0,0 SAY e_msg + " Press a key to continue."
  610. INKEY(0)
  611. @ 0,0
  612. RESTSCREEN(0,0,1,79,err_scrn)
  613. RETURN(.T.)
  614.  
  615.  
  616. * User_msg()
  617. * Prints user messages on row 24 and waits for
  618. * a key press.
  619. * Usage: User_msg("Message string")
  620. *
  621. FUNCTION User_msg
  622. PARAMETERS msg
  623. @ 24,0
  624. userscrn = SAVESCREEN(23,0,24,79)
  625. @ 24,0 SAY msg + " Press a key to continue."
  626. INKEY(0)
  627. @ 24,0
  628. RESTSCREEN(23,0,24,79,userscrn)
  629. RETURN(.T.)
  630.  
  631. *EOP: Db_demo.prg
  632.